package Farsail::PBS;

use strict;
use warnings;
use Carp;
use Farsail::PBS::Job;
use Log::Log4perl;

our $VERSION = '0.1.1';
our $MAXDEP = 30;
our $QSTOP = 'qstop';
our $QSTART = 'qstart';
our $QMGR = 'qmgr';
my $logger;

sub new {
    my $_class = shift;
    my $class = ref $_class || $_class;
    my $queue = shift || default_queue();
    if ( !$queue ) {
        confess "Queue name needed!";
    }
    my $self = { queue => $queue };
    bless $self, $class;
    $self->{id} = 0;
    $self->{jobs} = [];
    $self->{checked} = 0;
    $logger = Log::Log4perl->get_logger();
    return $self;
}

sub queue_name {
    my $self = shift;
    if ( @_ ) {
        $self->{queue} = shift;
    }
    return $self->{queue};
}

sub default_queue {
    my $conf = `$QMGR -c 'print server default_queue'`;
    ($conf) = grep { !/^#/ } split /\n/, $conf;
    if ( $conf ) {
        return (split /\s*=\s*/, $conf)[1];
    }
}

sub make_dummy_job {
    return "echo dummy job";
}

sub add_job {
    my ($self, $cmd, $deps) = @_;
    $self->{checked} = 0;
    if ( defined $deps ) {
        if ( ref $deps eq 'Farsail::PBS::Job' ) {
            $deps = [ $deps ];
        }
        elsif ( ref $deps ne 'ARRAY' ) {
            confess "deps should be a job or an arrayref of jobs.";
        }
        if ( scalar(@$deps) > $MAXDEP ) {
            my $i = 0;
            while ( 1 ) {
                my $end = $i + $MAXDEP - 1;
                if ( $end >= $#$deps ) {
                    my $lastjob = $self->add_job(make_dummy_job($i), [@{$deps}[$i..$#$deps]]);
                    $deps = [ $lastjob ];
                    last;
                }
                push @$deps, $self->add_job(make_dummy_job($i), [@{$deps}[$i..$end]]);
                $i = $end + 1;
            }
        }
    }
    my $job = Farsail::PBS::Job->new({ id => $self->{id},
                              command => $cmd,
                              deps => $deps || [] });
    $job->set_options(-q => $self->{queue});
    push @{$self->{jobs}}, $job;
    $self->{id}++;
    return $job;
}

sub check {
    my $self = shift;
    my @deps;
    my $jobs = $self->{jobs};
    for my $j ( @$jobs ) {
        my $dep = $j->deps;
        if ( $dep ) {
            $deps[$j->id] = [ map { $_->id } @{$dep} ];
        }
        else {
            $deps[$j->id] = [];
        }
    }
    my $seq = check_dag(\@deps);
    if ( defined $seq ) {
        $self->{checked} = 1;
        $self->{order_list} = $seq;
        return 1;
    }
}

sub check_dag {
    my $deps = shift;
    my (@checked, @path, @seqs);
    for ( 0..$#$deps ) {
        if ( is_circle($_, $deps, \@checked, \@path, \@seqs) ) {
            return undef;
        }
    }
    return \@seqs;
}

sub is_circle {
    my ($id, $deps, $checked, $path, $seqs) = @_;
    if ( $path->[$id] ) {
        return 1;
    }
    if ( $checked->[$id] ) {
        return 0;
    } elsif ( scalar(@{$deps->[$id]}) > 0 ) {
        $path->[$id] = 1;
        my $dep = $deps->[$id];
        for ( 0..$#$dep ) {
            if ( !is_circle($dep->[$_], $deps, $checked, $path, $seqs) ) {
                $path->[$id] = 0;
            } else {
                return 1;
            }
        }
    }
    $checked->[$id] = 1;
    push @$seqs, $id;
    return 0;
}

sub submit {
    my $self = shift;
    my $test = shift;
    
    if ( !$self->{checked} ) {
        if ( !$self->check() ) {
            confess "Can't submit without fix the dependence.";
        }
    }
    $logger->debug("$QSTOP $self->{queue}");
    unless ( $test ) {
        system($QSTOP, $self->{queue}) == 0
            or die "Can't stop queue $self->{queue}: $!";
    }
    my $jobs = $self->{jobs};
    for my $id ( @{$self->{order_list}} ) {
        if ( ! $jobs->[$id]->submit($test) ) {
            confess "jobs submit failed!";
        }
    }
    $logger->debug("$QSTART $self->{queue}");
    unless ( $test ) {
        system($QSTART, $self->{queue}) == 0
            or die "Can't start queue $self->{queue}: $!";
    }
    return 1;
}

1;
__END__

=head1 NAME

Farsail::PBS - Perl extension for PBS job submission

=head1 SYNOPSIS

  use Farsail::PBS;
  use Log::Log4perl qw(:easy);
  Log::Log4perl->easy_init($DEBUG);
  my $q = Farsail::PBS->new($queue_name);
  my $first = $q->add_job('echo start');
  $q->add_job('echo run after first', $first);
  if ( $q->check() ) {
     $q->submit();
  }
  else {
    die "Can't not resovle job dependence.";
  }

=head1 DESCRIPTION

This extension is intend to provide simple interface for PBS job
sumbmission. With this module, you don't have to take care of job
dependence and other issues.

=head2 METHODS

=over

=item  new($queue_name)

Create new job queue. All job will submit to this queue.

=item  add_job($cmd, $deps)

Add a new job. The $cmd is the command for the job. The $deps can be
another job or a reference to an array of jobs.

=item  check()

Try to resovle dependence for all jobs in the queue. Return false if
there is a dead-lock in the queue.

=item  submit($test)

Submit all jobs in the queue. If $test is true, print the command to
execute without really submit the job.

=back

=head1 SEE ALSO

L<Farsail::PBS::Job>, qsub(1), qstart(1), qstop(1),
http://www.clusterresources.com/

=head1 AUTHOR

Ye Wenbin, E<lt>wenbin.ye@alibaba-inc.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008 by Wenbin Ye

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.


=cut
